home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / geninput.zip / GENINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  5KB  |  222 lines
  1. {  GENINPUT.PAS
  2.    By Roland "Bud" Brown
  3.    Written to be shared with my friends in PROG_CON and anyone else
  4.    that wants to use it.
  5.  
  6.    This is a generalized input routine which uses the length of the string
  7.    passed to it and returns the same length of string to the calling routine
  8.    limits input to that length.  Masked imput set true cause the routine to 
  9.    skip any - character in the string for use in entering phone numbers date
  10.    etc (eg "   -  -    " ) would be passed to this in the Input string and 
  11.    the operator would have the hypens entered automatically.
  12.  
  13.    You invoke this routine as :
  14.       Inputit(1,10,String_To_Be_entered,True);
  15.  
  16.    This would be input String_To_Be_entered at line 10 column 1 and it IS
  17.    masked string (like ???-???-????) for a phone number.
  18.  
  19.    Now, if you want a different foreground/background from normal text you
  20.    should set the variable fore and bckgnd before comming here they will be
  21.    intially set to a black character on a white backgound.
  22.  
  23.    Left arrow is non destructive back spacing.
  24.    Right arrow moves cursor forward.
  25.    Back space key IS destructive.
  26.  
  27.    It is up to the routine which calls geninput to determine how to
  28.    handle the other special keys.  You can modify geninput to go to the
  29.    beginning of the data entry field on Home, to the end on the End key
  30.    add your own routines to handle any of the other special key combinations:
  31.    like Ctrl PgUp etc.
  32.  
  33.    Currently GenInput exits on all the special keys it recognizes:
  34.    HOME
  35.    END
  36.    PGUP
  37.    PGDN
  38.    UP ARROW
  39.    DOWN ARROW
  40.    AND ALL FUNCTION KEYS
  41.    GenInput expects the calling routine to handle those conditions and sets
  42.    the appropriate flag and returns.  The calling routine can check the
  43.    flag and perform the desired funtion.  Geninput also does not have
  44.    INS mode or use the DEL key.
  45.  
  46.    In short this is a beginning which you can modify to your hearts
  47.    delight - Enjoy!!
  48.  
  49. }
  50.  
  51. { GENINPUT.PAS (a TP Unit for generalized Keyboard Input)
  52.   By Roland "Bud" Brown
  53.  
  54.   Written to be shared with my friends in PROG_CON or anyone else
  55.   who would like to use it.
  56.  
  57. }
  58. Unit GenInput;
  59.  
  60.  Interface
  61.   Uses CRT;
  62.  
  63.   Type
  64.  
  65.   InputString = String[254];
  66.  
  67.   VAR
  68.    F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,PgUp,PgDn,HomeKey,EndKey,
  69.    UpArrow,DnArrow:Boolean;
  70.    Fore,Bckgnd,SaveAttr:byte;
  71.  
  72.  
  73.   Procedure Inputit(x,y:Integer; var Input:INputString; MaskedInput:Boolean);
  74.  
  75.   Implementation
  76.  
  77. Procedure Inputit;
  78.  
  79. Type
  80. Control = (New,Up,Down);
  81.  
  82.  
  83.  
  84. Var
  85. Scrl:Control;
  86. Xlength,CrrntX,CrrntY,EndLedger,StrngLength:Integer;
  87. InputChar:Char;
  88. BackupFlag:Boolean;
  89.  
  90.  
  91.  
  92. Procedure MoveRight;
  93.  Begin
  94.    BackupFlag:=True;
  95.    x:=x+1;
  96.    Xlength:=Xlength+1;
  97.    If (Input[Xlength]='-') and (XLength<=StrngLength) 
  98.                        and (MaskedInput) then MoveRight;
  99.  End;
  100.  
  101.  
  102. Procedure Backup;
  103.  
  104. Begin
  105.  BackupFlag:=True;
  106.  If CrrntX < x then x:=x-1;
  107.  Xlength:=Xlength-1;
  108.  If Xlength < 1 Then Xlength:=1;
  109.  If (Input[Xlength]='-') And (Xlength<> 1) and (MaskedInput) then Backup;
  110. End;
  111.  
  112.  
  113. Procedure RealBackup;
  114.  
  115. Begin
  116. BackUp;
  117. Input[Xlength]:=' ';
  118. Gotoxy(x,y); Write(' ');
  119. End;
  120.  
  121.  
  122. Procedure ReadIBM;
  123.  Var
  124.  IBMChar:Char;
  125.  
  126. Begin
  127.  BackupFlag:=False;
  128.  If KeyPressed then
  129.    Begin
  130.    IBMChar:=ReadKey;
  131.     Case IBMChar of
  132.     ';': F1:=TRUE;
  133.     '<': F2:=TRUE;
  134.     '=': F3:=TRUE;
  135.     '>': F4:=TRUE;
  136.     '?': F5:=TRUE;
  137.     '@': F6:=TRUE;
  138.     'A': F7:=TRUE;
  139.     'B': F8:=TRUE;
  140.     'C': F9:=TRUE;
  141.     'D': F10:=TRUE;
  142.     'K': Backup;   {Left Arrow}
  143.     'M': MoveRight;
  144.     'H': UpArrow:=TRUE;
  145.     'P': DnArrow:=TRUE;
  146.     'G': HomeKey:=TRUE;
  147.     'O': EndKey:=TRUE;
  148.     'I': PgUp:=TRUE;
  149.     'Q': PgDn:=TRUE;
  150.    End;
  151.      If not BackupFlag then
  152.      Xlength:=StrngLength+1; {Some Special key pressed so get out}
  153.   End;
  154.    If KeyPressed then ReadIBM;
  155.  End;
  156.  
  157.  
  158.  
  159. {***********PROCEDURE INPUTIT BEGINS AT THIS POINT*****************}
  160.  
  161.  Begin
  162.  SaveAttr:=TextAttr;
  163.  F1:=False;
  164.  F2:=False;
  165.  F3:=False;
  166.  F4:=False;
  167.  F5:=False;
  168.  F6:=False;
  169.  F7:=False;
  170.  F8:=False;
  171.  F9:=False;
  172.  F10:=False;
  173.  HomeKey:=False;
  174.  EndKey:=False;
  175.  PgUp:=False;
  176.  PgDn:=False;
  177.  UpArrow:=False;
  178.  DnArrow:=False;
  179.  BackupFlag:=False;
  180.  CrrntX:=x;
  181.  Xlength:=1;
  182.  CrrntY:=y;
  183.  StrngLength:= Length (Input);
  184.  TextColor(Fore);
  185.  TextBackGround(Bckgnd);
  186.  Gotoxy(Crrntx,Crrnty);
  187.  Write(Input);
  188.  Repeat
  189.   BackupFlag:=False;
  190.   GotoXY(x,y);
  191.   InputChar:=ReadKey;
  192.   If InputChar <> #13 Then
  193.    Begin
  194.    If InputChar <> #26 Then
  195.    Begin
  196.    Case InputChar of
  197.     #00:ReadIBM;
  198.     #08:RealBackup;
  199.    Else
  200.     Delete(Input,Xlength,1);
  201.     Insert(InputChar,Input,Xlength);
  202.     Gotoxy(x,y);
  203.     Write(InputChar);
  204.     x:=x+1;
  205.     Xlength:=Xlength+1;
  206. If (Input[Xlength]='-') and (Xlength<>1) and (Xlength<StrngLength) 
  207.                         and (MaskedInput) Then MoveRight;
  208.    End;
  209.    End;
  210.    End;
  211.    If InputChar=#13 then Xlength:=StrngLength+1;
  212.    If Inputchar=#26 then Xlength:=StrngLength+1;
  213.   Until Xlength = StrngLength+1;
  214.   TextAttr:=SaveAttr;
  215.   End;
  216.  
  217. Begin
  218. fore:=Black;
  219. Bckgnd:=White;
  220. End.
  221.  
  222.